home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / bbs / bbbbs84.lha / rexx / bbsWrite.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-12-14  |  26.5 KB  |  1,160 lines
  1. /* $VER: bbsWrite.rexx 8.3 (14.12.94)
  2. copyright © 1994 Richard Lee Stockton
  3. BBBBS write & setup email or message
  4. FREELY DISTRIBUTABLE
  5. */
  6.  
  7. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  8. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  9.  
  10. OPTIONS RESULTS
  11. SIGNAL ON BREAK_C
  12. SIGNAL ON BREAK_E
  13. SIGNAL ON FAILURE
  14. SIGNAL ON SYNTAX
  15.  
  16. PARSE ARG name maxtime edtype toname orig msgnum msgdir subj 
  17.  
  18. CALL TIME('R')
  19. IF toname='.' THEN toname=''
  20. IF orig='.' THEN orig=''
  21. subj=STRIP(subj)
  22. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  23. lineup='1B'x'M'
  24. CR=''
  25. IF ADDRESS()='BAUD' THEN
  26.   DO
  27.     CR='0D'x
  28.     frombb=1
  29.   END
  30. ELSE frombb=0
  31.  
  32. courtesy=''
  33. thechosen.=''
  34. CALL config()
  35. IF ~loaddata() THEN
  36.   DO
  37.     SAY 'Userfile' name 'failed to open for reading!'CR
  38.     EXIT 0
  39.   END
  40. SAY '                    'CR
  41. def=''
  42. pen3=''
  43. bak2=''
  44. IF colorflag=0 THEN
  45.   DO
  46.     def=''
  47.     pen3=''
  48.     bak2=''
  49.   END
  50. Friends.=''
  51. IF OPEN(f,bbspath'Friends/'name,'R')~=0 THEN
  52.   DO
  53.     DO i=1
  54.       Friends.i=READLN(f)
  55.       IF EOF(f) THEN LEAVE i
  56.     END
  57.     Friends.0=i-1
  58.     CALL CLOSE(f)
  59.   END
  60. IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
  61. ELSE 
  62.   DO
  63.     IF OPEN(f,bbspath'Lists/Conferences','R')~=0 THEN
  64.       DO
  65.         msg.=''
  66.         DO i=1
  67.           line=READLN(f)
  68.           IF line='END' | EOF(f) THEN LEAVE i
  69.           num=WORD(line,1)
  70.           IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
  71.           IF num=msgdir THEN LEAVE i
  72.         END
  73.         CALL CLOSE(f)
  74.       END
  75.     IF edtype='MSG' THEN
  76.       DO
  77.         IF msgdir=0 THEN
  78.           IF areaselect() THEN EXIT 0
  79.       END
  80.     lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  81.     IF edinfo(msgpath||msgdir'.txt',msg.msgdir,'Public Message Conference') THEN
  82.       EXIT 0
  83.   END
  84. IF toname='' THEN
  85.   DO
  86.     IF edtype='MAIL' THEN
  87.       DO
  88.         CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
  89.         toname=thechosen.1
  90.       END
  91.     ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  92.     toname=check_alias(toname)
  93.   END
  94. toname=SPACE(toname,1,'_')
  95. toname=cleanstring(1':'toname)
  96. IF toname='' | FIND(exclusion,toname)>0 THEN
  97.   DO
  98.     IF toname='' & edtype='MSG' THEN toname='ALL'
  99.     ELSE toname=sysop
  100.     SAY pen3'*** Re-Addressed to'def toname||CR
  101.   END
  102. IF toname~='ALL' THEN
  103.   DO
  104.     IF toname='BBBBS' THEN toname=sysop
  105.     IF ~EXISTS(bbspath'Users/'toname) THEN
  106.       DO
  107.         IF courtesy='' THEN CALL loadcourtesy()
  108.         IF FIND(courtesy,toname)=0 THEN
  109.           DO
  110.             SAY CR
  111.             SAY bak2' 'toname' is not on the user list! 'def||CR
  112.             IF edtype='MAIL' THEN EXIT 0
  113.             ELSE IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN EXIT 0
  114.           END
  115.       END
  116.   END
  117. IF toname=sysop THEN CALL sound('FEEDBACK')
  118. ELSE CALL sound('MESSAGE')
  119. IF edtype='MAIL' THEN
  120.   DO
  121.     CALL MAKEDIR(bbspath'EMail/'toname)
  122.     mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  123.   END
  124. ELSE
  125.   DO
  126.     CALL MAKEDIR(msgpath||msgdir)
  127.     mailname=msgpath||msgdir'/'lastwrit+1
  128.   END
  129. lynes.=''
  130. lynes.0=6
  131. IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
  132. ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
  133. lynes.2=' From:' name
  134. IF city~='' THEN lynes.2=lynes.2' - 'city
  135. lynes.3='   To:' toname                       /*  To: toname   MSG # */
  136. IF edtype='MAIL' THEN
  137.   DO
  138.     IF OPEN(f,bbspath||'Users/'toname,'R')~=0 THEN
  139.       DO
  140.         CALL READLN(f)
  141.         CALL READLN(f)
  142.         temp=READLN(f)
  143.         CALL CLOSE(f)
  144.         temp=docity(temp)
  145.         IF temp~='' THEN lynes.3=lynes.3' - 'temp
  146.       END
  147.     IF subj='|@NEW@|' THEN
  148.       DO
  149.         CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
  150.         subj='Welcome to' bbsname
  151.       END
  152.   END
  153. IF edtype='REPLY' THEN
  154.   DO
  155.     SAY pen3'Subj:'def subj||CR
  156.     temp=getinput(0 0 'Change the current subject? (Ny) > ')
  157.     IF LENGTH(temp)>3 THEN subj=temp
  158.     ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  159.   END
  160. IF subj='' THEN
  161.   DO
  162.     SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
  163.     subj=getinput(0 0 pen3': 'def)
  164.     IF level>sysoplevel THEN
  165.       DO
  166.         temp=bbspath'BBS_TEXT/SUBJ.'WORD(subj,1)
  167.         IF EXISTS(temp) THEN
  168.           IF getinput(1 1 'Use SUBJ.'WORD(subj,1)'? (nY) > ')~='N' THEN
  169.             CALL readlines(temp 7)
  170.       END
  171.   END
  172. IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
  173. IF subj='' THEN subj='?'
  174. lynes.4=' Subj:' subj
  175. lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
  176. IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
  177. lynes.6=LEFT('',74,'=')
  178. IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
  179. DO i=1 TO lynes.0
  180.   SAY lynes.i||CR
  181. END
  182. IF frombb THEN temp='File'
  183. ELSE temp='LOCAL'
  184. CALL writebuffer(scratch'/Message'temp)
  185. CALL DELETE(mailname)
  186. IF savelines(mailname) THEN EXIT 0
  187. CALL seelines(1)
  188. IF thechosen.0='' THEN
  189.   DO
  190.     thechosen.0=1
  191.     thechosen.1=toname
  192.   END
  193. carbons=thechosen.0+1
  194. DO FOREVER
  195.   IF thechosen.0>=carbons THEN
  196.     DO
  197.       junk='Copies To:'
  198.       DO cci=carbons TO thechosen.0
  199.         junk=junk thechosen.cci
  200.       END
  201.       SAY junk||CR
  202.     END
  203.   pline=''
  204.   IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  205.   pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  206.   pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  207.   junk=getinput(1 1 pline)
  208.   IF junk='E' THEN
  209.     DO
  210.       IF level>sysoplevel THEN firstedit=1
  211.       ELSE firstedit=7
  212.       IF bbsEd.rexx(firstedit mailname name TRUNC(maxtime-TIME('E'))-28)=2 THEN EXIT 0
  213.       junk='R'
  214.     END
  215.   ELSE IF edtype='MAIL' & junk='C' THEN
  216.     DO
  217.       CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
  218.       junk='R'
  219.     END
  220.   ELSE IF junk='K' THEN
  221.     DO
  222.       IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
  223.       EXIT 0
  224.     END
  225.   ELSE IF junk='U' THEN
  226.     DO
  227.       CALL txup(mailname)
  228.       junk='R'
  229.     END
  230.   IF junk='R' THEN
  231.     DO
  232.       CALL readlines(mailname 1)
  233.       CALL seelines(1)
  234.       nonstop=0
  235.     END
  236.   ELSE BREAK
  237. END
  238. IF edtype='MAIL' THEN
  239.   DO
  240.     IF orig~='' & toname~='' THEN
  241.       DO
  242.         IF toname=sysop THEN junk='Y'
  243.         ELSE junk=getinput(1 1 'Attach original mail from' toname'? (nY) > ')
  244.         IF junk~='N' THEN
  245.           IF ~readlines(orig 1) THEN CALL savelines(mailname)
  246.       END
  247.     junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
  248.     IF junk='Y' THEN
  249.       DO
  250.         savearg=arg
  251.         arg=''
  252.         IF frombb THEN arg=getinput(0 0 'Filename: ')
  253.         curdir=PRAGMA('D')
  254.         CALL MAKEDIR(bbspath'EmailFiles/'toname)
  255.         CALL setdir(bbspath'EmailFiles/'toname)
  256.         DO WHILE uload()=2
  257.         END
  258.         IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
  259.           DO
  260.             CALL readlines(mailname 1)
  261.             IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
  262.             CALL setdir(curdir)
  263.             CALL DELETE(mailname)
  264.             CALL savelines(mailname)
  265.           END
  266.         ELSE
  267.           DO
  268.             CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
  269.             SAY pen3'*** Upload failed! ***'def||CR
  270.           END
  271.         arg=savearg
  272.       END
  273.     totmail=WORD(data.17,2)
  274.     IF ~DATATYPE(totmail,'W') THEN totmail=1
  275.     ELSE totmail=totmail+1
  276.     data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  277.   END
  278. CALL readlines(mailname 1)
  279. DO ui=1 TO thechosen.0
  280.   IF thechosen.ui='' THEN ITERATE ui
  281.   IF ui>1 THEN
  282.     DO
  283.       CALL MAKEDIR(bbspath'Email/'thechosen.ui)
  284.       newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
  285.       IF ui<carbons THEN lynes.3='   To:' thechosen.ui
  286.       ELSE
  287.         DO
  288.           lynes.1=lynes.1'  (Carbon Copy)'
  289.           lynes.3='   To:' thechosen.1
  290.         END
  291.       CALL savelines(newname)
  292.       IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
  293.         DO
  294.           CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
  295.           ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
  296.           line2='Copied' WORD(lynes.1,4)
  297.           SAY line2 'to the' thechosen.ui 'file area.'CR
  298.           CALL send2log(line2)
  299.         END
  300.     END
  301.   line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  302.   IF edtype~='MAIL' THEN
  303.     DO
  304.       IF FIND(userlist,thechosen.ui)>0 THEN
  305.         CALL msgmark(thechosen.ui msgdir lastwrit+1)
  306.       line=line 'in' msg.msgdir
  307.     END
  308.   CALL send2log(line)
  309.   line=edtype 'Sent To' thechosen.ui
  310.   IF edtype~='MAIL' THEN line=line 'in the'pen3 msg.msgdir def'conference.'
  311.   SAY line||CR
  312. END
  313. IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
  314. ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
  315. CALL setdir(libpath||dirs.1)
  316. CALL savedata()
  317. EXIT 1
  318.  
  319.  
  320. msgmark:
  321. PARSE ARG markname markdir markmsg .
  322. IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
  323. mlines.=''
  324. DO mi=1
  325.   temp=READLN(f)
  326.   IF EOF(f) THEN LEAVE mi
  327.   mlines.mi=STRIP(temp)
  328. END
  329. CALL CLOSE(f)
  330. mlines.0=mi-1
  331. CALL DELAY(28)
  332. mlines.24=STRIP(mlines.24 markdir'/'markmsg)
  333. IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
  334. DO mi=1 TO mlines.0
  335.   CALL WRITELN(f,mlines.mi)
  336. END
  337. CALL CLOSE(f)
  338. RETURN
  339.  
  340.  
  341. edinfo:
  342. PARSE ARG t1,t2,t3
  343. IF level<sysoplevel THEN RETURN 0
  344. IF getinput(1 1 'Edit the'pen3 t2 def||t3 'info file? (Ny) > ')='Y' THEN
  345.   DO
  346.     IF ~EXISTS(t) THEN
  347.       DO
  348.         IF OPEN(f,t1,'W')~=0 THEN
  349.           DO
  350.             CALL WRITELN(f,TRIM(CENTER('***'pen3 t2 def||t3 '***',75)))
  351.             CALL WRITELN(f,LEFT('',75,'='))
  352.             CALL CLOSE(f)
  353.             CALL DELAY(28)
  354.           END
  355.       END
  356.     CALL bbsEd.rexx(1 t1 name TRUNC(maxtime-TIME('E'))-28)
  357.     RETURN 1
  358.   END
  359. RETURN 0
  360.  
  361.  
  362. areaselect:
  363. SAY pen3||LEFT('-',75,'-')||def||CR
  364. count=0
  365. smsg.=''
  366. DO i=1 TO level
  367.   IF msg.i='' THEN ITERATE i
  368.   count=count+1
  369.   smsg.count=msg.i i
  370. END
  371. smsg.0=count
  372. IF count>0 THEN CALL QSort(1,count,smsg)
  373. count=0
  374. msgs.=''
  375. DO i=1 TO smsg.0
  376.   tempnum=WORD(smsg.i,2)
  377.   tempdir=WORD(smsg.i,1)
  378.   IF FIND(data.21,tempnum)=0 THEN
  379.     DO
  380.       string=' '
  381.       IF tempnum<10 THEN string=string' '
  382.       string=string || tempnum'.'
  383.       IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
  384.         string=string LEFT(tempdir,20)
  385.       ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
  386.       count=count+1
  387.       msgs.count=string
  388.     END
  389. END
  390. DROP smsg.
  391. msgs.0=count%3
  392. IF (count//3)>0 THEN msgs.0=msgs.0+1
  393. DO i=1 TO msgs.0
  394.   DO j=1 TO 2
  395.     k=i+j*msgs.0
  396.     IF k<=count THEN msgs.i=msgs.i msgs.k
  397.   END
  398. END
  399. DO i=1 TO msgs.0
  400.   SAY msgs.i||CR
  401.   IF i//linesperpage=0 & i<msgs.0 THEN CALL waiting()
  402. END
  403. temp=getinput(1 0 pen3'Select Message Conference: 'def)
  404. IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
  405. IF msg.temp='' THEN RETURN 1
  406. msgdir=temp
  407. RETURN 0
  408.  
  409.  
  410. selectchosen:
  411. PARSE ARG startat selectline
  412. IF startat<2 THEN thechosen.=''
  413. line='Enter list of comma separated user names'
  414. IF level>sysoplevel THEN line=line 'or ALL'
  415. SAY line||CR
  416. thechosen.startat=getinput(1 0 selectline' ')
  417. IF STRIP(thechosen.startat)='' THEN RETURN 1
  418. thechosen.startat=SPACE(thechosen.startat,1,'_')
  419. thechosen.0=startat
  420. IF level>sysoplevel & thechosen.startat='ALL' THEN
  421.   thechosen.startat=SHOWDIR(bbspath'Users','F',',')
  422. IF POS(',',thechosen.startat)>0 THEN
  423.   DO
  424.     temp=TRANSLATE(thechosen.startat,' ',',')
  425.     thechosen.0=thechosen.0+WORDS(temp)-1
  426.     DO ei=1 TO WORDS(temp)
  427.       eii=startat+ei-1
  428.       thechosen.eii=STRIP(WORD(temp,ei))
  429.     END
  430.   END
  431. DO ei=startat TO thechosen.0
  432.   DO WHILE ~EXISTS(bbspath'Users/'thechosen.ei)
  433.     IF thechosen.ei~='' THEN
  434.       DO
  435.         IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
  436.           DO
  437.             thechosen.ei=sysop
  438.             ITERATE ei
  439.           END
  440.         IF courtesy='' THEN CALL loadcourtesy()
  441.         IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
  442.       END
  443.     SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
  444.     thechosen.ei=getinput(1 0 pen3||selectline' 'def)
  445.     IF thechosen.ei='' THEN
  446.       DO
  447.         IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
  448.           IF readlines(bbspath'Lists/USERS' 1)=0 THEN CALL seelines(1)
  449.         ITERATE ei
  450.       END
  451.     thechosen.ei=SPACE(thechosen.ei,1,'_')
  452.   END
  453. END
  454. RETURN 0
  455.  
  456.  
  457. loadcourtesy:
  458. IF EXISTS(bbspath'Lists/Courtesy') THEN
  459.   DO
  460.     IF OPEN(f,bbspath'Lists/Courtesy','R') THEN
  461.       DO
  462.         SAY 'Checking Courtesy List...'CR
  463.         DO i=1
  464.           line=READLN(f)
  465.           IF EOF(f) THEN BREAK
  466.           line=cleanstring(1':'line)
  467.           courtesy=courtesy line
  468.         END
  469.         CALL CLOSE(f)
  470.       END
  471.   END
  472. RETURN
  473.  
  474.  
  475. waiting:
  476. CALL checktime()
  477. IF waitchar='Q' THEN
  478.   DO
  479.     waitchar=''
  480.     RETURN
  481.   END
  482. waitchar=''
  483. IF nonstop=1 THEN RETURN
  484. OPTIONS PROMPT pen3'                          RETURN=Continue 'def
  485. PULL waitchar
  486. CALL cleanline(1)
  487. CALL checkdcd()
  488. RETURN
  489.  
  490.  
  491. waiting2:
  492. CALL checktime()
  493. IF nonstop=1 THEN RETURN 0
  494. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  495. IF waitchar='N' THEN
  496.   DO
  497.     nonstop=1
  498.     SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
  499.     SAY CR
  500.     CALL DELAY(99)
  501.     waitchar=''
  502.   END
  503. CALL cleanline(1)
  504. CALL checkdcd()
  505. IF waitchar='Q' THEN RETURN 1
  506. RETURN 0
  507.  
  508.  
  509. seelines:
  510. DO i=1 TO lynes.0
  511.   IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
  512.   ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
  513.     SAY pen3||lynes.i||def||CR
  514.   ELSE SAY lynes.i||CR
  515.   IF i//linesperpage=0 & i<lynes.0 THEN
  516.     IF waiting2() THEN LEAVE i
  517. END
  518. nonstop=0
  519. RETURN
  520.  
  521.  
  522. readlines:
  523. CALL CLOSE(f)
  524. PARSE ARG tempname readstart .
  525. IF OPEN(f,tempname,'R')=0 THEN RETURN 1
  526. IF readstart<2 THEN lynes.=''
  527. DO ri=readstart
  528.   line=READLN(f)
  529.   IF EOF(f) THEN BREAK
  530.   lynes.ri=line
  531. END
  532. lynes.0=ri-1
  533. CALL CLOSE(f)
  534. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  535. END
  536. lynes.0=ri
  537. RETURN 0
  538.  
  539.  
  540. savelines:
  541. PARSE ARG tempname .
  542. IF EXISTS(tempname) & edtype='MAIL' THEN
  543.   DO
  544.     ok=OPEN(f,tempname,'A')
  545.     IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  546.   END
  547. ELSE ok=OPEN(f,tempname,'W')
  548. IF ok=0 THEN
  549.   DO
  550.     line='***' tempname 'failed to open for saving!'
  551.     CALL send2log(line)
  552.     SAY line||CR
  553.     RETURN 1
  554.   END
  555. DO wi=1 TO lynes.0
  556.   CALL WRITELN(f,lynes.wi)
  557. END
  558. CALL CLOSE(f)
  559. RETURN 0
  560.  
  561.  
  562. setdir:
  563. PARSE ARG tempdir
  564. CALL PRAGMA('D',STRIP(tempdir))
  565. directory=PRAGMA('D')
  566. IF frombb THEN Data directory
  567. slash=LASTPOS('/',directory)
  568. IF slash=0 THEN slash=LASTPOS(':',directory)
  569. plaindir=directory
  570. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  571. RETURN
  572.  
  573.  
  574. config:
  575. arg='s:CONFIG.BBS'
  576. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  577. IF readlines(arg 1) THEN
  578.   DO
  579.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
  580.     EXIT 0
  581.   END
  582. compos=POS('/*',lynes.1)
  583. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  584. bbsname=STRIP(lynes.1)
  585. sysop=WORD(lynes.2,1)
  586. exclusion=STRIP(lynes.3)
  587. bbsdevice=WORD(lynes.4,1)
  588. sysoplevel=WORD(lynes.5,1)
  589. bbspath=WORD(lynes.6,1)
  590. IF ~EXISTS(bbspath) THEN
  591.   DO
  592.     SAY bbspath 'does not exist!'CR
  593.     EXIT 0
  594.   END
  595. testchar=RIGHT(bbspath,1)
  596. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  597. msgpath=WORD(lynes.7,1)
  598. IF ~EXISTS(msgpath) THEN
  599.   DO
  600.     SAY msgpath 'does not exist!'CR
  601.     SIGNAL DONE2
  602.   END
  603. testchar=RIGHT(msgpath,1)
  604. IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
  605. msgpath=msgpath'MSG'
  606. SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
  607. bbsprefs.=''
  608. DO i=16 TO 41
  609.   j=i-15
  610.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  611. END
  612. spellpath=WORD(lynes.9,1)
  613. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  614.   DO
  615.     SAY spellpath 'does not exist!'CR
  616.     bbsprefs.5=0
  617.   END
  618. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  619. ELSE scratch='RAM:Scratch'
  620. CALL MAKEDIR(scratch)
  621. RETURN
  622.  
  623.  
  624. writebuffer:
  625. PARSE ARG bufname .
  626. IF frombb THEN Capture OFF
  627. CALL DELETE(bufname)
  628. startnum=lynes.0+1
  629. SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
  630. IF EXISTS(bufname) THEN
  631.   DO
  632.     CALL DELAY(56)
  633.     CALL DELETE(bufname)
  634.     CALL DELAY(56)
  635.   END
  636. IF frombb THEN
  637.   DO
  638.     CaptWrap 74
  639.     Send pen3
  640.     Capture bufname
  641.     Send def
  642.     TimeOut 120
  643.     DO bufloop=1
  644.       Wait '/E,/S,RING,NO CARRIER'
  645.       Status 'L'
  646.       test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  647.       CALL checkdcd()
  648.       IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
  649.     END
  650.     IF test~='/X' THEN Send '\b\b'pen3
  651.     Capture OFF
  652.     CALL checkdcd()
  653.     TimeOut maxidle
  654.     SAY def||CR
  655.     CALL readlines(bufname startnum)
  656.     CALL wrapbuf(startnum)
  657.     QUEUE CR
  658.   END
  659. ELSE
  660.   DO
  661.     DO bufloop=startnum
  662.       PARSE PULL line
  663.       IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
  664.         LEAVE bufloop
  665.       lynes.bufloop=line
  666.     END
  667.     lynes.0=bufloop-1
  668.     CALL wrapbuf(startnum)
  669.     CALL DELETE(bufname)
  670.     CALL savelines(bufname)
  671.     SAY
  672.   END
  673. RETURN
  674.  
  675.  
  676. wrapbuf:
  677. ARG startnum .
  678. CALL cleanline(1)
  679. SAY pen3'Wordwrapping...'def||CR
  680. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  681. lynes.startnum=cleanstring(2':'lynes.startnum)
  682. DO wi=startnum WHILE wi<=lynes.0
  683.   wj=wi+1
  684.   lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  685.   lynes.wj=cleanstring(2':'lynes.wj)
  686.   IF LENGTH(lynes.wi)>75 THEN
  687.     DO
  688.       testchar=''
  689.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  690.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  691.         DO
  692.           DO wjj=lynes.0 TO wi+1 BY -1
  693.             wk=wjj+1
  694.             lynes.wk=lynes.wjj
  695.           END
  696.           lynes.wj=''
  697.           lynes.0=lynes.0+1
  698.         END
  699.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  700.         IF WORDS(lynes.wi)=1 THEN
  701.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  702.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  703.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  704.       END
  705.     END
  706. END
  707. RETURN
  708.  
  709.  
  710. txup:
  711. PARSE ARG uparg .
  712. IF frombb THEN
  713.   DO
  714.     SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
  715.     pline='Are you SURE your file is un-compressed text? (Ny) > '
  716.     IF getinput(1 1 pline)~='Y' THEN RETURN
  717.   END
  718. savearg=arg
  719. arg='Upload'
  720. arg2='tempfile1'
  721. IF frombb THEN arg=arg'File'
  722. ELSE
  723.   DO
  724.     arg=arg'LOCAL'
  725.     arg2=arg2'LOCAL'
  726.   END
  727. curdir=PRAGMA('D')
  728. CALL setdir(scratch)
  729. CALL DELETE(arg)
  730. CALL DELETE(arg2)
  731. IF uload()=0 THEN
  732.   DO
  733.     ADDRESS COMMAND 'C:copy' uparg scratch'/'arg2 'CLONE'
  734.     CALL DELETE(uparg)
  735.     ADDRESS COMMAND 'C:join' scratch'/'arg2 PRAGMA('D')'/'arg 'AS' uparg
  736.   END
  737. CALL readlines(uparg 1)
  738. CALL setdir(curdir)
  739. arg=savearg
  740. RETURN
  741.  
  742.  
  743. chpro:
  744. arg=UPPER(LEFT(arg,1))
  745. IF(arg='') THEN
  746.   DO
  747.     SAY CR
  748.     SAY '['pen3'W'def']- WXModem'CR
  749.     SAY '['pen3'X'def']- XModem-CRC'CR
  750.     SAY '['pen3'K'def']- XModem-1K'CR
  751.     SAY '['pen3'Y'def']- YModem'CR
  752.     SAY '['pen3'G'def']- YModem-G'CR
  753.     SAY '['pen3'Z'def']- ZModem'CR
  754.     SAY CR
  755.     arg=getinput(1 0 STRIP(protocol) '> ')
  756.  END
  757. IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
  758. Set arg
  759. Status Transfer
  760. protocol=STRIP(RESULT)
  761. SAY protocol||CR
  762. RETURN
  763.  
  764.  
  765. uload:
  766. CALL bbsspace(12)
  767. SAY CR
  768. IF bbsk<1 THEN
  769.   DO
  770.     line='Upload area is full!'
  771.     CALL send2log(line)
  772.     SAY pen3||line||def||CR
  773.     RETURN 1
  774.   END
  775. IF frombb THEN
  776.   DO
  777.     checkproto='T'
  778.     targ=arg
  779.     DO WHILE checkproto='T'
  780.       arg=''
  781.       SAY CR
  782.       SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  783.       pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  784.       pline=pline '['pen3'U'def']pload (qtU) > '
  785.       checkproto=getinput(1 1 pline)
  786.       IF checkproto='Q' THEN RETURN 1
  787.       IF checkproto='T' THEN CALL chpro()
  788.     END
  789.     arg=targ
  790.     CALL sound('UPLOAD')
  791.     uploadtime=TIME('E')
  792.     CALL checktime()
  793.     SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  794.     DownLoad arg
  795.     IF RC>0 THEN RETURN 2
  796.     IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
  797.     rbytes=WORD(STATEF(arg),2)
  798.     IF rbytes<1 THEN
  799.       DO
  800.         CALL DELETE(arg)
  801.         RETURN 2
  802.       END
  803.     temp=''
  804.     DO WHILE temp~='N' & temp~='Y'
  805.       temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
  806.     END
  807.     IF temp='N' THEN RETURN 2
  808.   END
  809. ELSE
  810.   DO
  811.     frompath=GETCLIP('BBS_frompath')
  812.     IF frompath='' THEN frompath='RAM:'
  813.     fdir=''
  814.     DO loop=1
  815.       fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
  816.       IF fromfile='' THEN RETURN 1
  817.       IF EXISTS(fromfile) THEN LEAVE loop
  818.       SAY
  819.       SAY fromfile 'does not exist!'
  820.     END
  821.     ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D') 'CLONE'
  822.     rbytes=WORD(STATEF(fromfile),2)
  823.     x=LASTPOS('/',fromfile)
  824.     IF x=0 THEN x=POS(':',fromfile)
  825.     IF x>0 THEN
  826.       DO
  827.         arg=SUBSTR(fromfile,x+1)
  828.         fdir=LEFT(fromfile,x)
  829.         IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
  830.         CALL SETCLIP('BBS_frompath',fdir)
  831.       END
  832.     ELSE arg=fromfile
  833.   END
  834. IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  835.   DO
  836.     SAY CR
  837.     SAY pen3'***'def arg pen3'failed archive check!'def||CR
  838.     SAY CR
  839.     temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
  840.     IF temp~='Y' THEN
  841.       DO
  842.         CALL DELETE(arg)
  843.         SAY CR
  844.         RETURN 2
  845.       END
  846.   END
  847. IF ~frombb THEN RETURN 0
  848. CALL bytes2user(14 rbytes)
  849. ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
  850. IF bbsprefs.9 & name~=sysop THEN
  851.   DO
  852.     newufile=bbspath'EMail/'sysop'/NEW_FILES'
  853.     IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  854.     ELSE
  855.       DO
  856.         ok=OPEN(f,newufile,'W')
  857.         IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
  858.       END
  859.     IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
  860.     CALL CLOSE(f)
  861.   END
  862. RETURN 0
  863.  
  864.  
  865. bytes2user:
  866. PARSE ARG indx bytes .
  867. tfiles=WORD(data.indx,1)
  868. tbytes=WORD(data.indx,3)
  869. IF ~DATATYPE(tfiles,'W') THEN tfiles=0
  870. IF ~DATATYPE(tbytes,'W') THEN tbytes=0
  871. tbytes=tbytes+bytes
  872. tfiles=tfiles+1
  873. IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
  874. ELSE data.indx='1 file' bytes 'bytes.'
  875. data.indx=data.indx DATE()
  876. CALL savedata(0)
  877. RETURN
  878.  
  879.  
  880. bbsspace:
  881. ARG tabspace .
  882. ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
  883. ok=OPEN(f,scratch'/infout','R')
  884. IF ok=0 THEN RETURN 20
  885. line=READLN(f)
  886. line=READLN(f)
  887. line=READLN(f)
  888. line=READLN(f)
  889. CALL CLOSE(f)
  890. IF tabspace<14 THEN SAY CR
  891. bbsk=WORD(line,4)
  892. IF ~DATATYPE(bbsk,'N') THEN
  893.   DO
  894.     line=bbsdevice 'is not an info compatible device!'
  895.     CALL send2log(line)
  896.     SAY pen3||line||def||CR
  897.     bbsk=0
  898.     RETURN
  899.   END
  900. bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
  901. IF bbsk<1 THEN bbsk=0
  902. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
  903. RETURN
  904.  
  905.  
  906. comma: PROCEDURE
  907. ARG num .
  908. t=''
  909. x=POS('.',num)
  910. IF x>0 THEN t=SUBSTR(num,x)
  911. num=num%1
  912. dgt=LENGTH(num)
  913. numtext=''
  914. IF dgt>3 THEN numtext=','RIGHT(num,3)
  915. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  916. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  917. IF dgt>12 THEN
  918.   DO
  919.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  920.     numtext=LEFT(num,dgt-12)||numtext
  921.   END
  922. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  923. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  924. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  925. ELSE numtext=num
  926. RETURN numtext||t
  927.  
  928.  
  929. loaddata:
  930. IF name='' THEN RETURN 0
  931. IF OPEN(f,bbspath'USERS/'name,'R')=0 THEN RETURN 0
  932. data.=''
  933. DO i=1
  934.   line=READLN(f)
  935.   IF EOF(f) THEN BREAK
  936.   data.i=line
  937. END
  938. data.0=i-1
  939. CALL CLOSE(f)
  940. city=docity(data.3)
  941. protocol=data.6
  942. IF ~DATATYPE(data.7,'W') | data.7<5 THEN data.7=20
  943. linesperpage=data.7
  944. IF ~frombb THEN linesperpage=20
  945. IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
  946. ELSE colorflag=0
  947. clr=''
  948. IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
  949. level=data.20
  950. RETURN 1
  951.  
  952.  
  953. savedata:
  954. IF OPEN(f,bbspath'USERS/'name,'W')=0 THEN RETURN
  955. IF data.0<27 THEN data.0=27
  956. DO i=1 TO data.0
  957.   CALL WRITELN(f,data.i)
  958. END
  959. CALL CLOSE(f)
  960. SAY 'User' name 'has been updated.'CR
  961. RETURN
  962.  
  963.  
  964. sound:
  965. ARG snd 
  966. IF bbsprefs.13=1 THEN RETURN
  967. ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd 
  968. RETURN
  969.  
  970.  
  971. check_alias:
  972. PARSE ARG ali .
  973. IF ~DATATYPE(Friends.0,'W') THEN RETURN ali
  974. DO ii=1 TO Friends.0
  975.   IF UPPER(WORD(Friends.ii,1))=UPPER(ali) THEN RETURN WORD(Friends.ii,2)
  976. END
  977. RETURN ali
  978.  
  979.  
  980. docity:
  981. PARSE ARG citi
  982. citi=TRANSLATE(citi,'          ','+-.,*/()<>')
  983. DO i=WORDS(citi) TO 1 BY -1
  984.   IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  985.   IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
  986. END
  987. citi=SPACE(citi,1)
  988. RETURN STRIP(citi)
  989.  
  990.  
  991. send2log:
  992. PARSE ARG sendline
  993. IF ~frombb THEN RETURN
  994. logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
  995. fl='W'
  996. IF EXISTS(logfile) THEN fl='A'
  997. IF ~OPEN('log',logfile,fl) THEN
  998.   DO
  999.     IF ~OPEN('log',logfile,fl) THEN
  1000.       DO
  1001.         SAY 'failed to open log file'
  1002.         RETURN
  1003.      END
  1004.   END
  1005. CALL WRITELN('log','bbsWrite:' sendline)
  1006. CALL CLOSE('log')
  1007. RETURN
  1008.  
  1009.  
  1010. checktime:
  1011. IF ~frombb THEN RETURN
  1012. IF TIME('E')>maxtime THEN EXIT
  1013. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  1014. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  1015. CALL checkdcd()
  1016. RETURN
  1017.  
  1018.  
  1019. cleanline:
  1020. ARG lflag .
  1021. IF nonstop=0 & clr~='' THEN
  1022.   DO
  1023.     Send clr
  1024.     RETURN
  1025.   END
  1026. IF colorflag~=1 & lflag=1 THEN RETURN
  1027. cline=lineup||LEFT(' ',78)
  1028. IF lflag=1 THEN cline=cline||lineup
  1029. SAY cline||CR
  1030. RETURN
  1031.  
  1032.  
  1033. getinput:
  1034. PARSE ARG upflag' 'oneflag' 'pline
  1035. CALL checkdcd()
  1036. OPTIONS PROMPT pline
  1037. PARSE PULL inarg
  1038. inarg=STRIP(inarg)
  1039. IF upflag THEN inarg=UPPER(inarg)
  1040. IF oneflag THEN inarg=LEFT(inarg,1)
  1041. inarg=cleanstring(0':'inarg)
  1042. RETURN inarg
  1043.  
  1044.  
  1045. strip_ansi:
  1046. PARSE ARG aline 
  1047. n=POS('1B'x,aline)
  1048. DO WHILE n>0
  1049.   DO k=2
  1050.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  1051.       leave k
  1052.   END
  1053.   aline=DELSTR(aline,n,k+1)
  1054.   n=POS('1B'x,aline)
  1055. END
  1056. RETURN aline
  1057.  
  1058.  
  1059. cleanstring:
  1060. PARSE ARG nflag':'cstr
  1061. IF nflag=1 THEN
  1062.   DO
  1063.     cstr=COMPRESS(cstr,"'`")
  1064.     cstr=TRANSLATE(cstr,,namemask)
  1065.     cstr=SPACE(cstr,1,'_')
  1066.     RETURN cstr
  1067.   END
  1068. bot=XRANGE(,'1F'x)
  1069. IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  1070. ELSE cstr=strip_ansi(cstr)
  1071. top=XRANGE('7F'x)
  1072. cstr=COMPRESS(cstr,bot||top)
  1073. IF nflag=0 THEN cstr=STRIP(cstr)
  1074. RETURN cstr
  1075.  
  1076.  
  1077. countcheck:
  1078. PARSE ARG fname' 'cknum' '.
  1079. IF ~EXISTS(fname) THEN
  1080.   DO
  1081.     IF cknum=0 THEN RETURN 0
  1082.     IF OPEN(f,fname,'W')=0 THEN RETURN 0
  1083.     CALL WRITELN(f,cknum)
  1084.     CALL CLOSE(f)
  1085.     RETURN cknum
  1086.   END
  1087. IF OPEN(f,fname,'R')=0 THEN
  1088.   DO
  1089.     CALL DELAY(99)
  1090.     IF OPEN(f,fname,'R')=0 THEN RETURN cknum
  1091.   END
  1092. retval=STRIP(READLN(f))
  1093. CALL CLOSE(f)
  1094. IF ~DATATYPE(retval,'W') THEN retval=0
  1095. IF ~DATATYPE(cknum,'W') THEN cknum=0
  1096. IF retval<cknum THEN
  1097.   DO
  1098.     IF OPEN(f,fname,'W')~=0 THEN
  1099.       DO
  1100.         CALL WRITELN(f,cknum)
  1101.         CALL CLOSE(f)
  1102.         RETURN cknum
  1103.       END
  1104.   END
  1105. RETURN retval
  1106.  
  1107.  
  1108. checkdcd:
  1109. IF ~frombb THEN RETURN
  1110. dcd
  1111. IF RC=0 THEN
  1112.   DO
  1113.     DO dcds=1 TO 3  /* 5 second delay */
  1114.       CALL DELAY(50)
  1115.       dcd
  1116.       IF RC~=0 THEN RETURN
  1117.     END
  1118.     dcd
  1119.     IF RC=0 THEN EXIT 0
  1120.   END
  1121. xmsg=GETCLIP('BBS_MESSAGE')
  1122. Capture
  1123. IF RC=0 & xmsg~='' THEN
  1124.   DO
  1125.     CALL SETCLIP('BBS_MESSAGE')
  1126.     SAY CR
  1127.     SAY bak2' Message From BBBBS: 'def||CR
  1128.     SAY xmsg||CR
  1129.     SAY CR
  1130.     CALL waiting()
  1131.   END
  1132. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
  1133. RETURN
  1134.  
  1135.  
  1136. BREAK_E:
  1137. i=999999
  1138. ri=999999
  1139. wi=999999
  1140. RETURN
  1141.  
  1142.  
  1143. BREAK_C:
  1144. EXIT 0
  1145.  
  1146.  
  1147. FAILURE:
  1148. SYNTAX:
  1149. lin.1=''ERRORTEXT(RC)''
  1150. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  1151. lin.3=SIGL ''SOURCELINE(SIGL)''
  1152. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  1153. DO er=1 TO 4
  1154.   IF level>sysoplevel | ~frombb THEN SAY 'bbsWrite:' lin.er||CR
  1155.   IF frombb THEN CALL send2log(lin.er)
  1156. END
  1157. EXIT 0
  1158.  
  1159. /* bbsWrite.rexx */
  1160.